home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gwu / parser.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-01-30  |  23.5 KB  |  927 lines
  1. /*
  2.     GWAda Development Environment for 386/486 PCs   
  3.     Copyright (C) 1993, Arthur Vargas Lopes  & Michael Bliss Feldman
  4.                         vlopes@vortex.ufrgs.br mfeldman@seas.gwu.edu
  5.  
  6.     This program is free software; you can redistribute it and/or modify
  7.     it under the terms of the GNU General Public License as published by
  8.     the Free Software Foundation; version 2 of the License.    
  9.  
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.     GNU General Public License for more details.
  15.  
  16.     You should have received a copy of the GNU General Public License
  17.     along with this program; if not, write to the Free Software
  18.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19. */
  20.  
  21. /* Parser.c */
  22.  
  23. #include "externs.h"
  24. #include "defines.h"
  25.  
  26. char *strupr(char *string);
  27. char *strcat(char *string1, const char *string2);
  28.  
  29.  
  30. typedef struct {
  31.     char yytext[AVL_MAX_LINEL + 1];
  32.     AVL_LINE_PTR temp;  /* Full source line */
  33.     int    yyleng;
  34.     int    code;
  35.     int    line_no;
  36.     int    line_col;
  37.     } TOKEN_TYPE;
  38.  
  39.  
  40. typedef struct {  /*  I/O structure  */
  41.     char        buffer[AVL_MAX_LINEL + 40];
  42.     char        last_token[AVL_MAX_LINEL + 1];
  43.     char        decimal_point;
  44.     int         size;
  45.     int         ibuf;
  46.     int         line_no;
  47.     int         look_ahead;
  48.     int         look_ahead_c[5];
  49.     int         look_ahead_t;
  50.     TOKEN_TYPE look_ahead_tcode[3];
  51.     } IO_TYPE;
  52.  
  53.  
  54.  
  55. IO_TYPE io_size;
  56.  
  57. #include "bsearch.c"
  58.  
  59.  
  60. void AVL_START_UP()
  61. {
  62.     int     ch;
  63.     char msg[100];
  64.     AVL_EDIT_WINDOW_PTR w;
  65.     w = &avl_windows[avl_window];
  66.     io_size.decimal_point     = '.';
  67.     io_size.look_ahead = 0;
  68.     io_size.line_no = w -> current_line -> line_no;
  69.     io_size.ibuf = w -> txt_col;
  70.     io_size.look_ahead_t = 0;
  71.     sprintf(io_size.buffer, w -> current_line -> line);
  72.     io_size.size = strlen(io_size.buffer);
  73.     sprintf(io_size.last_token,"THIS_IS_THE_END_OF_THE_FILE");
  74. }
  75.     
  76.  
  77. int AVL_NEXT()
  78. {
  79.     AVL_EDIT_WINDOW_PTR w;
  80.     AVL_LINE_PTR temp, temp2;
  81.     int     ch;
  82.     w = &avl_windows[avl_window];
  83.     if (io_size.look_ahead) { /* There is a look ahead char in the queue */
  84.         ch = io_size.look_ahead_c[0];
  85.         io_size.look_ahead_c[0] = io_size.look_ahead_c[1];
  86.         io_size.look_ahead_c[1] = io_size.look_ahead_c[2];
  87.         io_size.look_ahead_c[2] = io_size.look_ahead_c[3];
  88.         io_size.look_ahead_c[3] = io_size.look_ahead_c[4];
  89.         io_size.look_ahead -= 1;
  90.         return ch;
  91.         }
  92.     if (io_size.ibuf >= io_size.size)  {
  93.         if (w -> current_line -> next == w -> head)  
  94.             sprintf(io_size.buffer," \n THIS_IS_THE_END_OF_THE_FILE \" \n THIS_IS_THE_END_OF_THE_FILE  ");
  95.         else {
  96.             w -> current_line = w -> current_line -> next;
  97.             sprintf(io_size.buffer,"%s\n", w -> current_line -> line);
  98.             io_size.line_no = w -> current_line -> line_no;
  99.             }
  100.         io_size.size = strlen(io_size.buffer);
  101.         io_size.ibuf = 0;
  102.         }
  103.     ch = io_size.buffer[io_size.ibuf++];
  104.     if (ch == 26) ch = ' ';
  105.     if (ch == 0) return ' ';
  106.     return ch;
  107. }
  108.  
  109. void BACK(int     ch)
  110. {
  111.     if (io_size.look_ahead > 4)  {
  112.         AVL_ERROR("Too many look ahead bytes. SYSTEM ERROR...");
  113.         exit(1);
  114.         }
  115.     io_size.look_ahead_c[io_size.look_ahead++] = ch;
  116. }
  117.  
  118.  
  119. int IS_DIGIT(int ch, int base, int *n)  
  120. {
  121.     int     num;
  122.     char msg[40];
  123.     *n = 0;
  124.     if (ch >= 'A' && ch <= 'F')
  125.         num = ch - 'A' + 11;
  126.     else if (ch >= '0' && ch <= '9') 
  127.         num = ch - '0';
  128.     else 
  129.         return 0;
  130.     sprintf(msg,"%c in %d base ", ch, base);
  131.     if (num < 0 || num >= base)
  132.         AVL_ERROR(strcat("Based number with invalid digit ==> ",msg));
  133.     *n = num;
  134.     return 1;
  135. }
  136.  
  137. void BACK_T(TOKEN_TYPE tk)
  138. {
  139.     if (io_size.look_ahead_t > 2) {
  140.         AVL_ERROR("Too many look ahead tokens. SYSTEM ERROR...");
  141.         exit(1);
  142.         }
  143.     io_size.look_ahead_tcode[io_size.look_ahead_t++] = tk;
  144. }
  145.     
  146.  
  147. TOKEN_TYPE AVL_SCAN()
  148. {
  149.     int     ch, lch;
  150.     int     is_real = 0;
  151.     int     is_based = 0;
  152.     int     base = 10;
  153.     int     is_expo = 0;
  154.     int     string_mark;
  155.     int     temp;
  156.     static TOKEN_TYPE tk;
  157.     AVL_EDIT_WINDOW_PTR w;
  158.     char yytext[AVL_MAX_LINEL + 1];
  159.     w = &avl_windows[avl_window];
  160.  
  161.     if (io_size.look_ahead_t) {
  162.         tk = io_size.look_ahead_tcode[0];
  163.         io_size.look_ahead_tcode[0] = io_size.look_ahead_tcode[1];
  164.         io_size.look_ahead_tcode[1] = io_size.look_ahead_tcode[2];
  165.         io_size.look_ahead_t -= 1;
  166.         return tk;
  167.         }
  168.  
  169.     tk.yyleng = 0;
  170.     tk.yytext[0] = '\0';
  171. again:
  172.     /* First skip blanks */
  173.     while (isspace(ch = AVL_NEXT()));
  174.     /* Test comment */
  175.     if (ch == '-') {
  176.         ch = AVL_NEXT();
  177.         if (ch == '-') { /* Now reject til end of line */
  178.             while ((ch = AVL_NEXT()) != '\n');
  179.             goto again;
  180.             }
  181.         BACK('-');
  182.         BACK(ch);
  183.         }
  184.     else BACK(ch);
  185.     ch = AVL_NEXT();
  186.  
  187.     /* Now let's see what we got */
  188.  
  189.     tk.line_no  = io_size.line_no;
  190.     tk.line_col = io_size.ibuf;
  191.     tk.temp = w -> current_line;
  192.     if (isalpha(ch)) {  /* Got an object's name */ 
  193.         lch = ' ';
  194.         do {
  195.             if (tk.yyleng >= AVL_MAX_LINEL)  {
  196.                 tk.yytext[tk.yyleng] = '\0';
  197.                 AVL_ERROR(strcat("Symbol too long => ", tk.yytext));
  198.                 }
  199.             if (ch == '-' && lch == '-') {
  200.                 tk.yytext[tk.yyleng] = '\0';
  201.                 AVL_ERROR(strcat("Do not repeat _ ==> ", tk.yytext));
  202.                 }
  203.             tk.yytext[tk.yyleng++] = ch;
  204.             lch = ch;
  205.             ch = AVL_NEXT();
  206.             } while (isalpha(ch) || isdigit(ch) || ch == '_');
  207.         tk.yytext[tk.yyleng] = '\0';
  208.         strcpy(yytext,tk.yytext);
  209.         strupr(yytext);
  210.         if (lch == '_') 
  211.             AVL_ERROR(strcat("_ can't terminate an object's name ==> ", tk.yytext));
  212.         BACK(ch);
  213.         if (tk.code == XATTMARK) {  /* See if previous token was an ' */
  214.             lch = IS_ATT(yytext);
  215.             if (lch == 0)
  216.                 AVL_ERROR(strcat("Invalid attribute ==> ", tk.yytext));
  217.             tk.code = lch;
  218.             }
  219.         else {
  220.             if (!strcmp(yytext,"REM"))
  221.                 tk.code = XMULT;
  222.             else if (!strcmp(yytext,"MOD"))
  223.                 tk.code = XMULT;
  224.             else if (!strcmp(yytext,"AND"))
  225.                 tk.code = XLOG;
  226.             else if (!strcmp(yytext,"OR"))
  227.                 tk.code = XLOG;
  228.             else
  229.                 tk.code = IS_KEYWORD(yytext);
  230.             if (tk.code == 0)
  231.                 if (strcmp(io_size.last_token,yytext))
  232.                     tk.code = XID;
  233.             }
  234.         return tk;
  235.         }
  236.  
  237.                         
  238.     if (isdigit(ch))  {  /* Got a numeric literal */
  239.         lch = ' ';
  240.         do {
  241.             if (tk.yyleng >= AVL_MAX_LINEL)  {
  242.                 tk.yytext[tk.yyleng] = '\0';
  243.                 AVL_ERROR(strcat("Numeric literal too long ==> ", tk.yytext));
  244.                 }
  245.             if (lch == ch && ch == '_') {
  246.                 tk.yytext[tk.yyleng] = '\0';
  247.                 AVL_ERROR(strcat("Two _ repeated within numeric literal ==> ", tk.yytext));
  248.                 }
  249.             if (ch != '_')
  250.                 tk.yytext[tk.yyleng++] = ch;
  251.             lch = ch;
  252.             ch = AVL_NEXT();
  253.             } while (isdigit(ch) || ch == '_');
  254.         if (lch == '_') {
  255.             tk.yytext[tk.yyleng] = '\0';
  256.             AVL_ERROR(strcat("_ can't terminate an integer ==> ", tk.yytext));
  257.             }
  258.         if (ch == ':' || ch == '#')  { /* Got a based number */
  259.             is_based = ch;
  260.             tk.yytext[tk.yyleng] = '\0';
  261.             base = atoi(tk.yytext);
  262.             if (base < 2 || base > 16) 
  263.                 AVL_ERROR(strcat("Based literal with invalid base ==> ", tk.yytext));
  264.             tk.yyleng = 0;
  265.             ch = AVL_NEXT();
  266.             if (!IS_DIGIT(ch,base,&temp))
  267.                 AVL_ERROR("A digit was expected");
  268.             lch = ' ';
  269.             do {
  270.                 if (lch == ch && ch == '_') {
  271.                     tk.yytext[tk.yyleng] = '\0';
  272.                     AVL_ERROR(strcat("Two _ repeated within numeric literal ==> ", tk.yytext));
  273.                     }
  274.                 if (ch != '_')
  275.                     tk.yytext[tk.yyleng++] = ch;
  276.                 lch = ch;
  277.                 ch = AVL_NEXT();
  278.                 }  while (IS_DIGIT(ch,base,&temp) || ch == '_');
  279.             if (lch == '_') {
  280.                 tk.yytext[tk.yyleng] = '\0';
  281.                 AVL_ERROR(strcat("_ can't terminate an integer ==> ", tk.yytext));
  282.                 }
  283.             }
  284.         if (ch == io_size.decimal_point) { /* Got a real number? */
  285.             if (ch == '.')  {
  286.                 ch = AVL_NEXT();
  287.                 if (ch == '.')  {
  288.                     BACK('.');
  289.                     BACK('.');
  290.                     tk.yytext[tk.yyleng] = '\0';
  291.                     tk.code = XINTEGERLIT;
  292.                     return tk;
  293.                     }
  294.                 BACK(ch);
  295.                 }
  296.             is_real = 1;
  297.             tk.yytext[tk.yyleng++] = '.';
  298.             ch = AVL_NEXT();
  299.             if (!IS_DIGIT(ch,base,&temp))  {
  300.                 tk.yytext[tk.yyleng] = '\0';
  301.                 AVL_ERROR(strcat("A digit should follow a decimal point ==> ", tk.yytext));
  302.                 }
  303.             lch = ' ';
  304.             do {
  305.                 if (lch == ch && ch == '_') {
  306.                     tk.yytext[tk.yyleng] = '\0';
  307.                     AVL_ERROR(strcat("Two _ repeated within numeric literal ==> ", tk.yytext));
  308.                     }
  309.                 if (ch != '_')
  310.                     tk.yytext[tk.yyleng++] = ch;
  311.                 lch = ch;
  312.                 ch = AVL_NEXT();
  313.                 }  while (IS_DIGIT(ch,base,&temp) || ch == '_');
  314.             if (lch == '_') {
  315.                 tk.yytext[tk.yyleng] = '\0';
  316.                 AVL_ERROR(strcat("_ can't terminate an integer ==> ", tk.yytext));
  317.                 }
  318.             }
  319.         
  320.         if (is_based && is_based != ch) {
  321.             tk.yytext[tk.yyleng] = '\0';
  322.             AVL_ERROR(strcat("Missing based number delimiter ==> ", tk.yytext));
  323.             }
  324.         else if (is_based)
  325.             ch = AVL_NEXT();
  326.         if (toupper(ch) == 'E') {  /* Got an exponent */
  327.             is_expo = 1;
  328.             tk.yytext[tk.yyleng++] = ch;
  329.             ch = AVL_NEXT();
  330.             if (ch == '-' || ch == '+')  {
  331.                 if (!is_real && ch == '-')  {
  332.                     tk.yytext[tk.yyleng] = '\0';
  333.                     AVL_ERROR(strcat("E-<integer> can't be used in an integer number ==> ", tk.yytext));
  334.                     }
  335.                 tk.yytext[tk.yyleng++] = ch;
  336.                 ch = AVL_NEXT();
  337.                 }
  338.             if (!isdigit(ch))  {
  339.                 tk.yytext[tk.yyleng] = '\0';
  340.                 AVL_ERROR(strcat("A digit should follow a decimal point ==> ", tk.yytext));
  341.                 }
  342.             do {
  343.                 if (lch == ch && ch == '_') {
  344.                     tk.yytext[tk.yyleng] = '\0';
  345.                     AVL_ERROR(strcat("Two _ repeated within numeric literal ==> ", tk.yytext));
  346.                     }
  347.                 if (ch != '_')
  348.                     tk.yytext[tk.yyleng++] = ch;
  349.                 lch = ch;
  350.                 ch = AVL_NEXT();
  351.                 }  while (isdigit(ch) || ch == '_');
  352.             if (lch == '_') {
  353.                 tk.yytext[tk.yyleng] = '\0';
  354.                 AVL_ERROR(strcat("_ can't terminate an integer ==> ", tk.yytext));
  355.                 }
  356.             }
  357.         tk.yytext[tk.yyleng] = '\0';
  358.         if (is_real)
  359.             tk.code = XREALLIT;
  360.         else 
  361.             tk.code = XINTEGERLIT;
  362.         BACK(ch);
  363.         return tk;
  364.         }    /*  Done with numeric literal  */
  365.     
  366.  
  367.     switch(ch)  {
  368.  
  369.         case ':' :  {
  370.             ch = AVL_NEXT();
  371.             if (ch == '=')  {
  372.                 tk.code = XASSIGN;
  373.                 strcpy(tk.yytext,":=");
  374.                 }
  375.             else {
  376.                 BACK(ch);
  377.                 tk.code = ':';
  378.                 strcpy(tk.yytext,":");
  379.                 }
  380.             return tk;
  381.             }
  382.     
  383.         case ';' : case ',' : case '(' :
  384.         case ')' : case '|' : case '!' : case '&' : {
  385.             tk.code = ch;
  386.             if (ch == '!') ch = '|';
  387.             sprintf(tk.yytext,"%c",ch);
  388.             return(tk);
  389.             }
  390.  
  391.         case '\"' : case '%' :  {  /* Got a string */
  392.             string_mark = ch;
  393.             tk.yytext[tk.yyleng++] = ch;
  394.             while ( 1 )   {
  395.                 ch = AVL_NEXT();
  396.                 if (ch == string_mark)  {
  397.                     ch = AVL_NEXT();
  398.                     if (ch != string_mark)  { /* End of string */
  399.                         tk.yytext[tk.yyleng++] = string_mark;
  400.                         tk.yytext[tk.yyleng] = '\0';
  401.                         BACK(ch);
  402.                         tk.code = XSTRLIT;
  403.                         return tk;
  404.                         }
  405.                     }
  406.                 if (tk.yyleng >= AVL_MAX_LINEL)  {
  407.                     tk.yytext[tk.yyleng] = '\0';
  408.                     AVL_ERROR(strcat("String literal too long ==> ", tk.yytext));
  409.                     }
  410.                 if (ch == '\n')  {
  411.                     tk.yytext[tk.yyleng] = '\0';
  412.                     AVL_ERROR(strcat("String literal between lines ==> ", tk.yytext));
  413.                     }
  414.                 tk.yytext[tk.yyleng++] = ch;
  415.                 }
  416.             }
  417.  
  418.         case '+' : case '-' :  {
  419.             sprintf(tk.yytext,"%c",ch);
  420.             tk.code = XARIT;
  421.             return tk;
  422.             }
  423.  
  424.         case '/' :  {
  425.             ch = AVL_NEXT();
  426.             if (ch != '=')   {
  427.                 tk.code = XMULT;
  428.                 strcpy(tk.yytext,"/");
  429.                 return tk;
  430.                 }
  431.             sprintf(tk.yytext,"/=");
  432.             tk.code = XREL;
  433.             return tk;
  434.             }
  435.  
  436.         case '*' : {
  437.             ch = AVL_NEXT();
  438.             if (ch != '*')  
  439.                 BACK(ch);
  440.             else {
  441.                 strcpy(tk.yytext,"**");
  442.                 tk.code = XEXP;
  443.                 return tk;
  444.                 }
  445.             ch = '*';
  446.             sprintf(tk.yytext,"%c",ch);
  447.             tk.code = XMULT;
  448.             return tk;
  449.             }
  450.  
  451.         case '.' :  {
  452.             ch = AVL_NEXT();
  453.             if (ch == '.')  {
  454.                 strcpy(tk.yytext,"..");
  455.                 tk.code = XDOTDOT;
  456.                 return tk;
  457.                 }
  458.             BACK(ch);
  459.             strcpy(tk.yytext,".");
  460.             tk.code = '.';
  461.             return tk;
  462.             }
  463.  
  464.         case '\'' :   {  /* Got an attribute ?  */
  465.             ch = AVL_NEXT();
  466.             lch = AVL_NEXT();
  467.             if (lch == '\'') { /* Got a character literal!  */
  468.                 sprintf(tk.yytext,"%c",ch);
  469.                 tk.code = XCHARLIT;
  470.                 return tk;
  471.                 }
  472.             tk.code = XATTMARK;
  473.             strcpy(tk.yytext,"'");
  474.             BACK(lch);
  475.             BACK(ch);
  476.             return tk;
  477.             }
  478.  
  479.         case '=' : {
  480.             ch = AVL_NEXT();
  481.             if (ch == '>')  {
  482.                 strcpy(tk.yytext,"=>");
  483.                 tk.code = XEQGT;
  484.                 }
  485.             else 
  486.                 BACK(ch);
  487.             strcpy(tk.yytext,"=");
  488.             tk.code = XREL;
  489.             return tk;
  490.             }
  491.  
  492.         case '>' : case '<' : {
  493.             if (ch == '<')  {
  494.                 int k;
  495.                 k = ch;
  496.                 ch = AVL_NEXT();
  497.                 if (ch == '>')  {
  498.                     strcpy(tk.yytext,"<>");
  499.                     tk.code = XLTGT;
  500.                     return tk;
  501.                     }
  502.                 BACK(ch);
  503.                 ch = k;
  504.                 }
  505.             tk.code = XREL;
  506.             tk.yytext[0] = ch;
  507.             tk.yytext[1] = '\0';
  508.             tk.yytext[2] = '\0';
  509.             ch = AVL_NEXT();
  510.             if (ch == '=')  
  511.                 tk.yytext[1] = ch;
  512.             else
  513.                 BACK(ch);
  514.             return tk;
  515.             }
  516.                                 
  517.         default : {
  518.             sprintf(tk.yytext,"[decimal=%d]",ch);
  519.             AVL_ERROR(strcat("Invalid character ==> ", tk.yytext));
  520.             }
  521.         }
  522. }
  523.  
  524.  
  525. int IS_SIMPLE(char *s)
  526. {
  527.     if (!strcmp(s,"TEXT_IO")) return 0;
  528.     if (!strcmp(s,"ASCII")) return 0;
  529.     if (!strcmp(s,"STANDARD")) return 0;
  530.     if (!strcmp(s,"CALENDAR")) return 0;
  531.     if (!strcmp(s,"SYSTEM")) return 0;
  532.     if (!strcmp(s,"MACHINE_CODE")) return 0;
  533.     if (!strcmp(s,"IO_EXCEPTIONS")) return 0;
  534.     if (!strcmp(s,"LOW_LEVEL_IO")) return 0;
  535.     return 1;
  536. }
  537.  
  538. int pos_p = 0;
  539. int AVL_Append_In_Text;
  540. static AVL_EDIT_WINDOW AVL_Parsing, AVL_Appending;
  541. static int AVL_Parser_Pos = 1, AVL_Parser_Line = -100;
  542.  
  543. void AVL_OUT_BODY(FILE *fp, TOKEN_TYPE tk)
  544. {
  545.     int i;
  546.     AVL_Parsing = avl_windows[avl_window];
  547.     if (AVL_Parser_Line == -100) {
  548.         AVL_Parser_Line = tk.line_no;
  549.         AVL_Parser_Pos = 1;
  550.         if (AVL_Append_In_Text)  {
  551.             /* Go to last line of current text */
  552.             AVL_DO_GOTO(AVL_Parsing.head -> previous -> line_no);
  553.             AVL_CURSOR_END();
  554.             AVL_EDIT_ENTER(); /* Insert a blank line */
  555.             AVL_EDIT_ENTER(); /* Insert a blank line */
  556.             AVL_Appending = avl_windows[avl_window];        
  557.             }
  558.         }
  559.     if (AVL_Parser_Line != tk.line_no)  {
  560.         AVL_Parser_Pos = 1; 
  561.         AVL_Parser_Line = tk.line_no; 
  562.         if (AVL_Append_In_Text == 0)
  563.             fprintf(fp,"\n"); 
  564.         else {
  565.             avl_windows[avl_window] = AVL_Appending;
  566.             AVL_CURSOR_END();
  567.             AVL_EDIT_ENTER(); /* Insert a blank line */
  568.             avl_windows[avl_window].txt_col = 0;
  569.             AVL_Appending = avl_windows[avl_window];        
  570.             }
  571.         }
  572.     if (pos_p) {
  573.         AVL_Parser_Pos = 1;
  574.         tk.line_col = pos_p;
  575.         }
  576.     avl_windows[avl_window] = AVL_Appending;
  577.     for( ; AVL_Parser_Pos < tk.line_col; ++AVL_Parser_Pos) {
  578.         if (AVL_Append_In_Text == 0)
  579.             fprintf(fp," ");
  580.         else 
  581.             AVL_EDIT_INSERT(' ');
  582.         }
  583.     AVL_Appending = avl_windows[avl_window];        
  584.     if (AVL_Append_In_Text == 0)
  585.         fprintf(fp,"%s", tk.yytext);
  586.     else {
  587.         avl_windows[avl_window] = AVL_Appending;
  588.         for(i=0; i < strlen(tk.yytext); ++i)
  589.             if (tk.yytext[i] == '\n')  {
  590.                 AVL_CURSOR_END();
  591.                 AVL_EDIT_ENTER();
  592.                 }
  593.             else
  594.                 AVL_EDIT_INSERT(tk.yytext[i]);
  595.         AVL_Appending = avl_windows[avl_window];        
  596.         }
  597.     avl_windows[avl_window] = AVL_Parsing;
  598.     AVL_Parser_Pos += strlen(tk.yytext);
  599. }
  600.  
  601. void AVL_SKIP_RECORD()
  602. {
  603.     TOKEN_TYPE tk;
  604.     tk = AVL_SCAN();
  605.     while ( tk.code != 0 )  {
  606.         if (tk.code == XRECORD) AVL_SKIP_RECORD();
  607.         else if (tk.code == XEND)  {
  608.             tk = AVL_SCAN();
  609.             if (tk.code == XRECORD) return;
  610.             else if (tk.code == XCASE) tk = AVL_SCAN();
  611.             else {
  612.                 AVL_ERROR("First make sure the package spec is correct.");
  613.                 tk.code = 0;
  614.                 BACK_T(tk);
  615.                 return;
  616.                 }
  617.             }
  618.         if (tk.code == XPROCEDURE || tk.code == XFUNCTION || tk.code == XTASK)  {
  619.             tk.code = 0;
  620.             BACK_T(tk);
  621.             return;
  622.             }
  623.         tk = AVL_SCAN();
  624.         }
  625. }
  626.  
  627. int AVL_FAIL(FILE *fp)            
  628. {
  629.     fclose(fp);
  630.     AVL_ERROR("Syntax error within package spec.");
  631.     return -1;
  632. }
  633.  
  634. int AVL_PARSER()
  635. {
  636.     TOKEN_TYPE tk, tk2, tk3, tk4, tk5, tk6;
  637.     static int first = 0;
  638.     static char fname[161];
  639.     static char lastfn[121];
  640.     static char *msg = " GWAda - Create Body in File? ";
  641.     char msg2[161];
  642.     AVL_WIN_PTR m = NULL;
  643.     int nt = 0;
  644.     int i, j, code;
  645.     short with_entry = 0;
  646.     AVL_EDIT_WINDOW_PTR w;
  647.     AVL_LINE_PTR temp, temp2;
  648.     FILE *fopen(), *fp = NULL;
  649.     w = &avl_windows[avl_window];
  650.     pos_p = 0;
  651.     AVL_START_UP();
  652.  
  653.     tk = AVL_SCAN();
  654.     if (tk.code != XPACKAGE)
  655.         tk = AVL_SCAN();
  656.     switch(tk.code)  {
  657.         case XPACKAGE :  /* Where packages are defined? */
  658.             tk2 = AVL_SCAN(); /* got package's name */
  659.             if (tk2.code == XBODY) 
  660.                 break;
  661.             tk3 = AVL_SCAN();  /* got is? */
  662.             if (tk3.code != XIS)     
  663.                 break;
  664.             tk4 = AVL_SCAN();
  665.             if (tk4.code == XNEW) 
  666.                 return 0;
  667.             tk6 = tk2;
  668.             /* Got a package speck */
  669.             sprintf(msg2,"Append the template at the end of this file (Y/N) ? ");
  670.             if (AVL_QUESTION(msg2) == 'Y')  
  671.                 AVL_Append_In_Text = 1;
  672.             else {
  673.                 AVL_Append_In_Text = 0;
  674.                 /* Now ask for a package body name */
  675.                 m = AVL_MAKE_WINDOW(msg,7,4,9,5+62,avl_wnd_bk_color,avl_wnd_color);
  676.                 if (first == 0)
  677.                     sprintf(lastfn,"%s%c*.ada",avl_dir_sources,92);
  678.                 first = 1;
  679.                 strcpy(fname,lastfn);
  680.                 if (AVL_PROMPT(1,1,fname,60)) {
  681.                     AVL_DEL_WINDOW(m);
  682.                     return -1;
  683.                     }
  684.                 strcpy(lastfn,fname);
  685.                 if ((fp = fopen(fname,"r")) != NULL)  {
  686.                     sprintf(msg2,"File %s already exists. Overwrite (Y/N) ? ", fname);
  687.                     if (AVL_QUESTION(msg2) != 'Y')  {
  688.                         AVL_DEL_WINDOW(m);
  689.                         return -1;
  690.                         }
  691.                     fclose(fp);
  692.                     unlink(fname);
  693.                     }
  694.                 fp = fopen(fname,"w");
  695.                 if (fp == NULL)  {
  696.                     sprintf(msg2,"Can't create file %s", fname);
  697.                     AVL_ERROR(msg2);
  698.                     AVL_DEL_WINDOW(m);
  699.                     return -1;
  700.                     }
  701.                 }
  702.             AVL_OUT_BODY(fp,tk); /* Output PACKAGE in the correct text position */            
  703.             strcpy(tk.yytext," BODY "); AVL_OUT_BODY(fp,tk); 
  704.             AVL_OUT_BODY(fp,tk2); /* Output PACKAGE name */            
  705.             strcpy(tk.yytext," IS\n"); 
  706.             AVL_OUT_BODY(fp,tk); 
  707.             while ( tk4.code != 0 )  {
  708.                 switch( tk4.code ) {
  709.                     case XTASK      : {
  710.                         tk5 = tk4;
  711.                         with_entry = 0;
  712.                         AVL_OUT_BODY(fp,tk4);
  713.                         strcpy(tk4.yytext," BODY ");
  714.                         AVL_OUT_BODY(fp,tk4);
  715.                         tk2 = AVL_SCAN(); /* tk2 hold the task's name */
  716.                         if (tk2.code == 0) return AVL_FAIL(fp);
  717.                         if (tk2.code == XTYPE) {
  718.                             tk2 = AVL_SCAN();
  719.                             if (tk2.code == 0) return AVL_FAIL(fp);
  720.                             }
  721.                         AVL_OUT_BODY(fp,tk2);
  722.                         tk3 = tk2;
  723.                         strcpy(tk3.yytext," IS");
  724.                         AVL_OUT_BODY(fp,tk3);
  725.                         strcpy(tk5.yytext,"BEGIN");
  726.                         tk5.line_no = 0;
  727.                         AVL_OUT_BODY(fp,tk5);
  728.                         tk3 = AVL_SCAN(); 
  729.                         if (tk3.code == 0) return AVL_FAIL(fp);
  730.                         if (tk3.code == ';')  {
  731.                             tk6 = tk5;
  732.                             tk6.line_no += 1;
  733.                             tk6.line_col += avl_tab_size;
  734.                             sprintf(tk6.yytext,"NULL;");
  735.                             AVL_OUT_BODY(fp,tk6);
  736.                             tk6.line_no += 1;
  737.                             tk6.line_col -= avl_tab_size;
  738.                             sprintf(tk6.yytext,"END %s;\n",tk2.yytext);
  739.                             AVL_OUT_BODY(fp,tk6);
  740.                             break;
  741.                             }
  742.  
  743.                         tk3 = AVL_SCAN(); 
  744.                         if (tk3.code == 0) return AVL_FAIL(fp);
  745.                         while (tk3.code == XENTRY)  {
  746.                             tk6 = tk3;
  747.                             with_entry = 1;
  748.                             strcpy(tk3.yytext,"ACCEPT ");
  749.                             AVL_OUT_BODY(fp,tk3);
  750.                             tk4 = AVL_SCAN();
  751.                             if (tk4.code == 0) return AVL_FAIL(fp);
  752.                             AVL_OUT_BODY(fp,tk4);  /* output entry name */
  753.                             tk3 = AVL_SCAN();
  754.                             if (tk3.code == ';')  {
  755.                                 AVL_OUT_BODY(fp,tk3); 
  756.                                 tk3 = AVL_SCAN();
  757.                                 continue;
  758.                                 }
  759.                             if (tk3.code == '(')  {
  760.                                 while (tk3.code != ')')  {
  761.                                     if (tk3.code == 0) return AVL_FAIL(fp);
  762.                                     tk.line_col += 1;
  763.                                     AVL_OUT_BODY(fp,tk3); 
  764.                                     tk3 = AVL_SCAN();
  765.                                     }
  766.                                 AVL_OUT_BODY(fp,tk3); 
  767.                                 tk3 = AVL_SCAN();
  768.                                 }
  769.                             tk5 = tk3;
  770.                             strcpy(tk5.yytext," DO");
  771.                             AVL_OUT_BODY(fp,tk5);
  772.                             tk6.line_no = 0;
  773.                             tk6.line_col += avl_tab_size;
  774.                             sprintf(tk6.yytext,"NULL;");
  775.                             AVL_OUT_BODY(fp,tk6);
  776.                             tk6.line_no += 1;
  777.                             tk6.line_col -= avl_tab_size;
  778.                             sprintf(tk6.yytext,"END %s;",tk4.yytext);
  779.                             AVL_OUT_BODY(fp,tk6);
  780.                             tk3 = AVL_SCAN();
  781.                             }
  782.                         while (tk3.code != XEND) {
  783.                             if (tk3.code == 0) return AVL_FAIL(fp);
  784.                             tk3 = AVL_SCAN();
  785.                             }
  786.                         if (!with_entry)  {
  787.                             tk4 = tk3;
  788.                             tk4.line_no = 0;
  789.                             tk4.line_col += avl_tab_size;
  790.                             sprintf(tk4.yytext,"NULL;");
  791.                             AVL_OUT_BODY(fp,tk4);
  792.                             }
  793.                         sprintf(tk3.yytext,"END %s;\n",tk2.yytext);
  794.                         AVL_OUT_BODY(fp,tk3);
  795.                         break;
  796.                         }
  797.                     case XPROCEDURE :
  798.                     case XFUNCTION  :  {
  799.                         AVL_OUT_BODY(fp,tk4);
  800.                         tk2 = AVL_SCAN(); /* tk2 hold the routine's name */
  801.                         if (tk2.code == 0) return AVL_FAIL(fp);
  802.                         AVL_OUT_BODY(fp,tk2);
  803.                         tk3 = AVL_SCAN(); 
  804.                         if (tk3.code == 0) return AVL_FAIL(fp);
  805.                         if (tk3.code == '(')  {
  806.                             AVL_OUT_BODY(fp,tk3);
  807.                             tk3 = AVL_SCAN();
  808. /*                            pos_p = tk3.line_col;   */
  809.                             while (tk3.code != ')')  {
  810.                                 if (tk3.code == 0) return AVL_FAIL(fp);
  811. /*                                tk3.line_col = pos_p;   */
  812.                                 AVL_OUT_BODY(fp,tk3); 
  813.                                 tk3 = AVL_SCAN();
  814.                                 }
  815.                             AVL_OUT_BODY(fp,tk3); 
  816.                             tk3 = AVL_SCAN();
  817.                             }
  818.                         if (tk3.code == 0) return AVL_FAIL(fp);
  819.                         if (tk3.code == XRETURN)  {
  820.                             AVL_OUT_BODY(fp,tk3);
  821.                             tk3 = AVL_SCAN();
  822.                             if (tk3.code == 0) return AVL_FAIL(fp);
  823.                             AVL_OUT_BODY(fp,tk3);
  824.                             tk5 = tk3;
  825.                             strcpy(tk5.yytext," IS");
  826.                             AVL_OUT_BODY(fp,tk5);
  827.                             tk4.line_no = 0;
  828.                             tk4.line_col += avl_tab_size;
  829.                             sprintf(tk4.yytext,"Result : %s;",tk3.yytext); 
  830.                             AVL_OUT_BODY(fp,tk4);
  831.                             strcpy(tk4.yytext,"BEGIN"); 
  832.                             tk4.line_no += 1;
  833.                             tk4.line_col -= avl_tab_size;
  834.                             AVL_OUT_BODY(fp,tk4);
  835.                             tk4.line_no += 1;
  836.                             tk4.line_col += avl_tab_size;
  837.                             sprintf(tk4.yytext,"RETURN Result;");
  838.                             AVL_OUT_BODY(fp,tk4);
  839.                             }
  840.                         else {
  841.                             tk5 = tk3;
  842.                             strcpy(tk5.yytext," IS");
  843.                             AVL_OUT_BODY(fp,tk5);
  844.                             tk4.line_no = 0;
  845.                             strcpy(tk4.yytext,"BEGIN"); 
  846.                             AVL_OUT_BODY(fp,tk4);
  847.                             tk4.line_no += 1;
  848.                             tk4.line_col += avl_tab_size;
  849.                             sprintf(tk4.yytext,"NULL;");
  850.                             AVL_OUT_BODY(fp,tk4);
  851.                             }
  852.                         sprintf(tk4.yytext,"END %s;\n",tk2.yytext);
  853.                         tk4.line_no += 1;
  854.                         tk4.line_col -= avl_tab_size;
  855.                         AVL_OUT_BODY(fp,tk4);
  856.                         break;
  857.                         }
  858.                     case XRECORD :
  859.                         AVL_SKIP_RECORD();
  860.                         break;
  861.                     case XEND    :
  862.                         AVL_OUT_BODY(fp,tk4);
  863.                         tk = AVL_SCAN();
  864.                         if (tk.code == 0) return AVL_FAIL(fp);
  865.                         if (tk.code != ';') {
  866.                             AVL_OUT_BODY(fp,tk);
  867.                             tk = AVL_SCAN();
  868.                             }
  869.                         if (tk.code == 0) return AVL_FAIL(fp);
  870.                         AVL_OUT_BODY(fp,tk);
  871.                         if (AVL_Append_In_Text == 0)  {
  872.                             fprintf(fp,"\n");
  873.                             fclose(fp);
  874.                             }
  875.                         else {
  876.                             AVL_Parsing = avl_windows[avl_window];        
  877.                             avl_windows[avl_window] = AVL_Appending;
  878.                             AVL_EDIT_ENTER();
  879.                             AVL_Appending = avl_windows[avl_window];        
  880.                             avl_windows[avl_window] = AVL_Parsing;
  881.                             }
  882.  
  883.                         fp = NULL;
  884.                         AVL_DEL_WINDOW(m);
  885.                         return 1;
  886.                     default :
  887.                         break;
  888.                     }
  889.                 tk4 = AVL_SCAN();
  890.                 }
  891.         default :
  892.             break;
  893.         }
  894.     if (fp != NULL)
  895.         AVL_ERROR("Invalid syntax for package spec.");
  896.     sprintf(tk4.yytext,"END;");
  897.     tk4.line_no += 1000;
  898.     tk4.line_col = 1;
  899.     AVL_OUT_BODY(fp,tk4);
  900.     AVL_DEL_WINDOW(m);
  901.     return 0;
  902. }    
  903.  
  904. void AVL_BODY()
  905. {
  906.     AVL_EDIT_WINDOW_PTR w;
  907.     int old_txt;
  908.     AVL_LINE_PTR temp, temp2;
  909.     w = &avl_windows[avl_window];
  910.     AVL_Appending = avl_windows[avl_window];
  911.     AVL_Parser_Pos = 1;
  912.     AVL_Parser_Line = -100;
  913.     old_txt = w -> txt_col;
  914.     temp = w -> current_line;
  915.     AVL_WORD_BACKWARD();
  916.     if (!AVL_PARSER())
  917.         AVL_ERROR("Press F7 only when the cursor is over a valid PACKAGE spec.");
  918.     if (AVL_Append_In_Text)  {
  919.         avl_windows[avl_window] = AVL_Appending;
  920.         AVL_UPDATE_SCREEN();
  921.         }
  922.     else {
  923.         w -> current_line = temp;
  924.         w -> txt_col = old_txt;
  925.         }
  926. }
  927.  
  928.